Power Tools for Macintosh/Power Tools for Macintosh (SoftBit)(1992).iso/Stacks/*F-I/HyperCard Utilities/Videodisc⁄Drivers ƒ/PioneerLVP4200.p

Text File | 1987-02-06 | 8.4 KB | 331 lines | [TEXT/MPS ]

{$R-}
{$D+}
(*
    Pioneer LVP 4200 -- a WildCard user-defined command to drive a laser disc player.

    To compile and link this file using Macintosh Programmer's Workshop,

    pascal PioneerLVP4200.p
    link -o WildCommands -sn Main=PioneerLVP4200 -sn STDIO=PioneerLVP4200 ∂
         -sn INTENV=PioneerLVP4200 -rt WCMD=5 ∂
         PioneerLVP4200.p.o {MPW}libraries:interface.o

    then use ResEdit to copy the resulting WCMD from WildCommands
    and paste it into WildCard, the Home stack, or your own stack.
    (WCMD=1 Panasonic, =2 Hitachi, =3 Phillips, =4 PioneerLDV6000,
     =5 PioneerLVP4200)
*)

UNIT DummyUnit;

INTERFACE

   USES MemTypes, QuickDraw, OsIntf;

IMPLEMENTATION

PROCEDURE Pioneer(commandPtr: Ptr);                                        FORWARD;

   PROCEDURE EntryPoint(arg: Ptr);
   { entry point cannot have local procs, but forward routines can }
   BEGIN
     Pioneer(arg);
   END;

   PROCEDURE Pioneer(commandPtr: Ptr);
   VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
       message: Str255;
       refNum: INTEGER;
       err: INTEGER;

     PROCEDURE OpenSerial;
     VAR handShake: SerShk;
         baudRate: INTEGER;
     BEGIN
       baudRate := 4800;
       { for now, use modem port so we don't mess with AppleTalk }
       err := FSOpen('.AOUT',0,refNum);
       IF err = 0 THEN
         BEGIN
           WITH handShake DO
             BEGIN
               fXon := 1;
               fCTS := 1;
               xon  := CHR(17);
               xoff := CHR(19);
               errs := 0;
               evts := 0;
               fInx := 0;
             END;
           err := SerHShake(refNum,handShake);
           IF err = 0 THEN
             err := Control(refNum,13,@baudRate);
         END;
     END;


     PROCEDURE CloseSerial;
     BEGIN
       err := FSClose(refNum);
     END;


     PROCEDURE SendCommand(cmd: Str255);
     VAR count: LongInt;
     { all commands must have an extra char at end }
     BEGIN
       count := Length(cmd);
       cmd[count] := CHAR(13);   { carriage return }
       err := FSWrite(refNum, count, Pointer(Ord(@cmd)+1));
     END;

     PROCEDURE SendDirect;
     VAR charCnt, skip: LongInt;
       { direct commands must have an extra char at the end }
     BEGIN
       charCnt := Length(message);
       message[charCnt] := CHAR(13);   { carriage return }
       skip := Length('PioneerLVP4200 direct') + 1;
       err := FSWrite(refNum, charCnt, Pointer(Ord(@message)+skip));
     END;

     FUNCTION Concat(str1, str2, str3: Str255): Str255;
     VAR result: Str255;
         resultLen: INTEGER;
         charNum: INTEGER;
     BEGIN
       result := '';
       resultLen := 0;
       FOR charNum := 1 TO Length(str1) DO
         BEGIN
           resultLen := resultLen + 1;
           result[resultLen] := str1[charNum];
         END;
       FOR charNum := 1 TO Length(str2) DO
         BEGIN
           resultLen := resultLen + 1;
           result[resultLen] := str2[charNum];
         END;
       FOR charNum := 1 TO Length(str3) DO
         BEGIN
           resultLen := resultLen + 1;
           result[resultLen] := str3[charNum];
         END;
      result[0] := CHR(resultLen);
      Concat := result;
     END;


     PROCEDURE GetMessage;
     VAR charNum: INTEGER;
         msgChar: CHAR;
     BEGIN
       { skip command name }
       WHILE (commandPtr^ <> 0) AND (commandPtr^ <> 13) AND (CHR(commandPtr^) <> ' ') DO
         commandPtr := Pointer(Ord(commandPtr)+1);

       { skip following white space }
       WHILE CHR(commandPtr^) = ' ' DO
         commandPtr := Pointer(Ord(commandPtr)+1);

       { extract the rest into a Str255 }
       charNum := 0;
       WHILE (commandPtr^ <> 0) AND (charNum < 255) DO
         BEGIN
           msgChar := CHR(commandPtr^);
           commandPtr := Pointer(Ord(commandPtr)+1);
           charNum := charNum + 1;
           IF (ORD(msgChar) >= ORD('A')) AND (ORD(msgChar) <= ORD('Z')) THEN
             message[charNum] := CHR(ORD('a') + (ORD(msgChar) - ORD('A')))
           ELSE message[charNum] := msgChar;
         END;
       message[0] := CHR(charNum);
     END;


     FUNCTION Contains(target: Str255): BOOLEAN;
     VAR offset: INTEGER;

       FUNCTION Match: BOOLEAN;
       VAR index: INTEGER;
       BEGIN
         Match := TRUE;
         FOR index := 1 TO Length(target) DO
           IF offset + index > Length(message) THEN
             BEGIN
               Match := FALSE;  { ran off the end }
               EXIT(Match);
             END
           ELSE IF target[index] <> message[offset+index] THEN
             BEGIN
               Match := FALSE;  { hit a wrong char }
               EXIT(Match);
             END;
       END;

     BEGIN
       Contains := FALSE;
       FOR offset := 0 TO Length(message) - 1 DO
         IF Match THEN
           BEGIN
             Contains := TRUE;
             EXIT(Contains);
           END;
     END;


     FUNCTION GetDigit(digit: CHAR): Str255;
     BEGIN
       CASE digit OF
         { doing a type conversion }
         '0': GetDigit := '0';
         '1': GetDigit := '1';
         '2': GetDigit := '2';
         '3': GetDigit := '3';
         '4': GetDigit := '4';
         '5': GetDigit := '5';
         '6': GetDigit := '6';
         '7': GetDigit := '7';
         '8': GetDigit := '8';
         '9': GetDigit := '9';
       END;
     END;


     FUNCTION GetInteger: Str255;
     { get an integer in Pioneer format }
     VAR digitLoc, charVal: INTEGER;
         intStr: Str255;
     BEGIN
       intStr := '';
       FOR digitLoc := 1 TO Length(message) DO
         BEGIN
           charVal := ORD(message[digitLoc]);
           IF (charVal >= ORD('0')) AND (charVal <= ORD('9')) THEN
             intStr := Concat(intStr, GetDigit(message[digitLoc]), '');
         END;
       GetInteger := intStr;
     END;

   BEGIN
     OpenSerial;
     IF err <> 0 THEN
       BEGIN
         SysBeep(1);
         EXIT(Pioneer);
       END;

     GetMessage;

     { set flags }
     reverseFlag := Contains('rev');
     offFlag := Contains('off');
     tillFlag := Contains('till');

     IF Contains('stop') THEN SendCommand('ST^')
     ELSE IF Contains('eject') THEN SendCommand('RJ OP^')
     ELSE IF Contains('search') THEN SendCommand(Concat(GetInteger, 'SE', '^'))
     ELSE IF Contains('step') THEN
       BEGIN
         IF reverseFlag THEN SendCommand('SR^')
         ELSE SendCommand('SF^')
       END
     ELSE IF Contains('play') THEN
       BEGIN
         IF tillFlag THEN SendCommand(Concat('FR ', GetInteger, ' PL^'))
         ELSE IF reverseFlag THEN SendCommand('60 SP MR^')  { speed normal, multi-reverse }
         ELSE SendCommand('PL^')
       END
     ELSE IF Contains('slow') THEN
       BEGIN
         IF reverseFlag THEN SendCommand('30 SP MR^')
         ELSE SendCommand('30 SP MF^')
       END
     ELSE IF Contains('slow') THEN
       BEGIN
         IF tillFlag THEN
           BEGIN
             IF reverseFlag THEN SendCommand(Concat('30 SP FR ', GetInteger, ' MR^'))
             ELSE SendCommand(Concat('30 SP FR ', GetInteger, ' MF^'));
           END
         ELSE IF reverseFlag THEN SendCommand('30 SP MR^')
           ELSE SendCommand('30 SP MF^')
       END
     ELSE IF Contains('slower') THEN
       BEGIN
         IF tillFlag THEN
           BEGIN
             IF reverseFlag THEN SendCommand(Concat('15 SP FR ', GetInteger, ' MR^'))
             ELSE SendCommand(Concat('15 SP FR ', GetInteger, ' MF^'));
           END
         ELSE IF reverseFlag THEN SendCommand('15 SP MR^')
           ELSE SendCommand('15 SP MF^')
       END
     ELSE IF Contains('slowest') THEN
       BEGIN
         IF tillFlag THEN
           BEGIN
             IF reverseFlag THEN SendCommand(Concat('10 SP FR ', GetInteger, ' MR^'))
             ELSE SendCommand(Concat('10 SP FR ', GetInteger, ' MF^'));
           END
         ELSE IF reverseFlag THEN SendCommand('10 SP MR^')
           ELSE SendCommand('10 SP MF^')
       END
     ELSE IF Contains('fast') THEN
       BEGIN
         IF tillFlag THEN
           BEGIN
             IF reverseFlag THEN SendCommand(Concat('180 SP FR ', GetInteger, ' MR^'))
             ELSE SendCommand(Concat('180 SP FR ', GetInteger, ' MF^'));
           END
         ELSE IF reverseFlag THEN SendCommand('180 SP MR^')
           ELSE SendCommand('180 SP MF^')
       END
     ELSE IF Contains('faster') THEN
       BEGIN
         IF tillFlag THEN
           BEGIN
             IF reverseFlag THEN SendCommand(Concat('240 SP FR ', GetInteger, ' MR^'))
             ELSE SendCommand(Concat('240 SP FR ', GetInteger, ' MF^'));
           END
         ELSE IF reverseFlag THEN SendCommand('240 SP MR^')
           ELSE SendCommand('240 SP MF^')
       END
     ELSE IF Contains('scan') THEN
       BEGIN
         IF reverseFlag THEN SendCommand('NR^')
         ELSE SendCommand('NF^')
       END
     ELSE IF Contains('picture') THEN
       BEGIN
         IF offFlag THEN SendCommand('0VD^')
         ELSE SendCommand('1VD^')
       END
     ELSE IF Contains('frame') THEN
       BEGIN
         IF offFlag THEN SendCommand('0DS^')
         ELSE SendCommand('1DS^')
       END
     ELSE IF Contains('sound') THEN
       BEGIN
         IF Contains('1') THEN
           IF offFlag THEN SendCommand('0AD^')
           ELSE SendCommand('1AD^')
         ELSE IF Contains('2') THEN
           IF offFlag THEN SendCommand('0AD^')
           ELSE SendCommand('2AD^')
         ELSE IF offFlag THEN SendCommand('0AD^')
           ELSE SendCommand('3AD^')  { stereo on }
       END
     ELSE IF Contains('init') THEN SendCommand('SA^')
     ELSE IF Contains('direct') THEN  SendDirect
         { direct commands must have an extra char at the end }
     ELSE  SysBeep(1); { unknown command }
     CloseSerial;
   END;

END.